home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / comm / cpt152.zip / CPT-S152.ZIP / NUMDAYS.PAS < prev   
Pascal/Delphi Source File  |  1996-05-16  |  2KB  |  95 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. UNIT NumDays;
  6.  
  7. INTERFACE
  8.  
  9. CONST
  10.   DaysPerYear = 365;
  11. TYPE
  12.   Month = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
  13.   Date = RECORD
  14.            da: 1..31;
  15.            mo: Month;
  16.            yr: 1..9999
  17.          END;
  18.  
  19. VAR
  20.   maxDay: ARRAY [Month] OF INTEGER;
  21.   daysBefore: ARRAY [Month] OF INTEGER;
  22.  
  23. PROCEDURE MonthsInit;
  24. FUNCTION IsLeapYear (CONST yr: INTEGER): BOOLEAN;
  25. FUNCTION NumOfDays (CONST D: Date): LONGINT;
  26.   { contains FUNCTION IsLeapYear(Const yr: INTEGER): BOOLEAN;   }
  27. FUNCTION Num_Days (CONST D: STRING): LONGINT;
  28.  
  29. IMPLEMENTATION
  30.  
  31. PROCEDURE MonthsInit;
  32. VAR mo: Month;
  33. BEGIN
  34.   maxDay [Jan] := 31;
  35.   maxDay [Feb] := 28;  (* adjust for leap years later *)
  36.   maxDay [Mar] := 31;
  37.   maxDay [Apr] := 30;
  38.   maxDay [May] := 31;
  39.   maxDay [Jun] := 30;
  40.   maxDay [Jul] := 31;
  41.   maxDay [Aug] := 31;
  42.   maxDay [Sep] := 30;
  43.   maxDay [Oct] := 31;
  44.   maxDay [Nov] := 30;
  45.   maxDay [Dec] := 31;
  46.  
  47.   daysBefore [Jan] := 0;
  48.   FOR mo := Jan TO Nov DO
  49.     daysBefore [Month (Ord (mo) + 1) ] := daysBefore [mo] + maxDay [mo]
  50. END;
  51.  
  52. FUNCTION IsLeapYear (CONST yr: INTEGER): BOOLEAN;
  53. BEGIN
  54.   IsLeapYear := ((yr MOD 4 = 0) AND (yr MOD 100 <> 0)) OR (yr MOD 400 = 0)
  55. END;
  56.  
  57. FUNCTION NumOfDays (CONST D: Date): LONGINT;
  58.   (* NumOfDays returns an ordinal value for the date
  59.      with January 1, 0001 assigned the value 1.    *)
  60.  
  61. VAR result, lYr: LONGINT;
  62. BEGIN
  63.   WITH D DO BEGIN
  64.     lYr := yr - 1;
  65.     result := (da);
  66.     Inc (result, daysBefore [mo]);
  67.     Inc (result, lYr * DaysPerYear);
  68.     Inc (result, ((lYr DIV 4) - (lYr DIV 100) + (lYr DIV 400)));
  69.     IF (mo > Feb) AND IsLeapYear (yr) THEN Inc (result)
  70.   END;
  71.   NumOfDays := result
  72. END;
  73.  
  74. FUNCTION Num_Days (CONST D: STRING): LONGINT;
  75. VAR
  76.   dateRec : Date;
  77.   Tmonth,
  78.   VErr    : INTEGER;
  79. BEGIN
  80.   WITH dateRec DO BEGIN
  81.     Val (Copy (D, 4, 2), da, VErr);
  82.     Val (Copy (D, 1, 2), Tmonth, VErr);
  83.     mo := Month (TMonth - 1);
  84.     Val (Copy (D, 7, 2), yr, VErr);
  85.     if yr >= 80
  86.       then yr := 1900 + yr  {assume 1980-1999, rather than 2080-2099}
  87.       else yr := 2000 + yr
  88.   END;
  89.   Num_Days := NumOfDays (dateRec);
  90. END;
  91.  
  92. BEGIN
  93.   MonthsInit         { for NumDays procedure }
  94. END.
  95.